home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s5.arc / RECEIVX1.MOD < prev    next >
Text File  |  1987-07-18  |  48KB  |  1,325 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           Receive_Xmodem_File --- Download file using XMODEM         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Receive_Xmodem_File( Use_CRC : BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Receive_Xmodem_File                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Downloads file from remote host using XMODEM         *)
  12. (*                 protocol.                                            *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Receive_Xmodem_File( Use_CRC );                               *)
  17. (*                                                                      *)
  18. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  19. (*                       of XMODEM; FALSE to use Checksum version.      *)
  20. (*                                                                      *)
  21. (*     Remarks:                                                         *)
  22. (*                                                                      *)
  23. (*        The transmission parameters are automatically set to:         *)
  24. (*                                                                      *)
  25. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  26. (*                                                                      *)
  27. (*        and then they are automatically restored to the previous      *)
  28. (*        values when the transfer is complete.                         *)
  29. (*                                                                      *)
  30. (*        This code actually controls file reception using any of the   *)
  31. (*        Xmodem-based protocols:  Xmodem, Modem7, Telink, and Ymodem.  *)
  32. (*                                                                      *)
  33. (*     Calls:   KeyPressed                                              *)
  34. (*              Async_Send                                              *)
  35. (*              Async_Receive                                           *)
  36. (*              Async_Receive_With_TimeOut                              *)
  37. (*              Async_Purge_Buffer                                      *)
  38. (*              Update_Xmodem_Receive_Display                           *)
  39. (*              Display_Receive_Error                                   *)
  40. (*              Receive_Xmodem_Sector                                   *)
  41. (*              Receive_Telink_Header                                   *)
  42. (*              Receive_Ymodem_Header                                   *)
  43. (*              Wait_For_SOH                                            *)
  44. (*              Set_File_Date_And_Time                                  *)
  45. (*              Draw_Menu_Frame                                         *)
  46. (*              Open_Receiving_File                                     *)
  47. (*              Write_File_Handle                                       *)
  48. (*              Close_File_Handle                                       *)
  49. (*                                                                      *)
  50. (*----------------------------------------------------------------------*)
  51.  
  52. CONST
  53.    XOFF_Delay    = 250             (* WXModem XOFF delay time           *);
  54.    WXmodem_Flush = 4               (* Blocks to flush when error        *);
  55.    SEALink_Flush = 6               (* Blocks to flush when error        *);
  56.  
  57. VAR
  58.    Sector_Count  : INTEGER         (* Sector count -- no wrap at 255    *);
  59.    Sector_Comp   : BYTE            (* Complement of current sector #    *);
  60.    Sector_Prev   : BYTE            (* Previous sector number            *);
  61.    I             : INTEGER         (* Loop index                        *);
  62.    Error_Count   : INTEGER         (* # of errors encountered           *);
  63.    Ch            : INTEGER         (* Character read from COM port      *);
  64.    Error_Flag    : BOOLEAN         (* IF an error is found              *);
  65.    Initial_Ch    : INTEGER         (* Initial character                 *);
  66.    Sector_Length : INTEGER         (* Sector Length                     *);
  67.    Sector_Prev1  : BYTE            (* Previous sector + 1               *);
  68.    BlockL_Errors : INTEGER         (* Counts block length errors        *);
  69.    SOH_Errors    : INTEGER         (* Counts SOH errors                 *);
  70.    BlockN_Errors : INTEGER         (* Counts block number errors        *);
  71.    Comple_Errors : INTEGER         (* Counts complement errors          *);
  72.    TimeOut_Errors: INTEGER         (* Counts timeout errors             *);
  73.    Resend_Errors : INTEGER         (* Counts resend block errors        *);
  74.    CRC_Errors    : INTEGER         (* Counts checksum/crc errors        *);
  75.    Effective_Rate: REAL            (* Effective baud rate of transfer   *);
  76.    CRC_Tries     : INTEGER         (* Initial CRC tries                 *);
  77.    WXM_Tries     : INTEGER         (* Initial WXModem tries             *);
  78.    SOH_Time      : INTEGER         (* Seconds to wait for SOH           *);
  79.    RFile_Size    : REAL            (* Actual file size                  *);
  80.    RFile_Date    : REAL            (* File date/time                    *);
  81.    File_Date     : INTEGER         (* MS DOS encoded file date          *);
  82.    File_Time     : INTEGER         (* MS DOS encoded file time          *);
  83.    RFile_Name    : AnyStr          (* Received file name, Ymodem        *);
  84.    Truncate_File : BOOLEAN         (* TRUE to trunc. file to exact size *);
  85.    RFile_Open    : BOOLEAN         (* TRUE if receiving file opened     *);
  86.    XFile_Byte    : FILE OF BYTE    (* For truncating received file      *);
  87.    OK_Transfer   : BOOLEAN         (* If transfer OK                    *);
  88.    Block_Zero    : BOOLEAN         (* If block 0 encountered            *);
  89.  
  90.    RFile_Size_2  : REAL            (* File size from totalling sectors  *);
  91.    TName         : ShortStr        (* Transfer type                     *);
  92.  
  93.    Display_Time  : BOOLEAN         (* Display time remaining for trans. *);
  94.    Time_To_Send  : REAL            (* Time in seconds to transfer file  *);
  95.    Start_Time    : REAL            (* Starting time of transfer         *);
  96.    End_Time      : REAL            (* Ending time of transfer           *);
  97.    Time_Per_Block: REAL            (* Time for one block                *);
  98.    Blocks_To_Get : REAL            (* Number of blocks                  *);
  99.    Write_Count   : INTEGER         (* Number of bytes to write          *);
  100.    Err           : INTEGER         (* Error flag for handle I/O         *);
  101.  
  102.                                    (* Write buffer pointer              *)
  103.    Write_Buffer  : File_Handle_Buffer_Ptr;
  104.    Buffer_Pos    : INTEGER         (* Current buffer position           *);
  105.    Buffer_Length : INTEGER         (* Buffer length                     *);
  106.    Use_CRC_2     : BOOLEAN         (* TRUE to use CRC method            *);
  107.    Menu_Title    : AnyStr          (* Menu title                        *);
  108.    Alt_R_Pressed : BOOLEAN         (* TRUE if Alt-R cancelled download  *);
  109.    Long_Buffer   : BOOLEAN         (* TRUE if separate buffer used      *);
  110.    Kbd_Ch        : CHAR            (* Character entered from keyboard   *);
  111.    Full_File_Name: AnyStr          (* Full file name of file to receive *);
  112.    Dup_Block     : BOOLEAN         (* TRUE if duplicate block error     *);
  113.    BS_Flag       : BOOLEAN         (* Swallows up duplicate block       *);
  114.    W_Count       : INTEGER         (* Count to write                    *);
  115.    Do_ACKs       : BOOLEAN         (* TRUE to do ACKs                   *);
  116.  
  117.    Block_Start_Set : SET OF ^A..^Z (* Set of legal block start chars    *);
  118.    SVal            : STRING[10]    (* For debugging conversions         *);
  119.    Flush_Count     : INTEGER       (* Count of blocks to flush if bad   *);
  120.    Save_XonXoff    : BOOLEAN       (* Saves XON/XOFF status             *);
  121.    Err_Mess        : AnyStr        (* Error message                     *);
  122.  
  123. (*----------------------------------------------------------------------*)
  124. (*           Open_Receiving_File --- open file to receive download      *)
  125. (*----------------------------------------------------------------------*)
  126.  
  127. PROCEDURE Open_Receiving_File;
  128.  
  129. VAR
  130.    Err        : INTEGER;
  131.    B          : BOOLEAN;
  132.    Local_Save : Saved_Screen_Ptr;
  133.  
  134. BEGIN (* Open_Receiving_File *)
  135.                                    (* Check if file name given yet. *)
  136.                                    (* If not, prompt for it.        *)
  137.    IF FileName = '' THEN
  138.       BEGIN
  139.  
  140.          B              := Do_Status_Time;
  141.          Do_Status_Time := FALSE;
  142.  
  143.          Save_Partial_Screen( Local_Save, 1, Max_Screen_Line,
  144.                               Max_Screen_Col, Max_Screen_Line );
  145.  
  146.          Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
  147.  
  148.          GoToXY( 1 , Max_Screen_Line );
  149.  
  150.          WRITE('Enter file name to receive download: ');
  151.          ClrEol;
  152.  
  153.          Read_Edited_String( FileName );
  154.  
  155.          Restore_Screen( Local_Save );
  156.  
  157.          Do_Status_Time := B;
  158.  
  159.       END;
  160.                                    (* Append download directory name *)
  161.                                    (* if necessary.                  *)
  162.  
  163.    IF ( POS( '\' , FileName ) = 0 ) AND
  164.       ( POS( ':' , FileName ) = 0 ) THEN
  165.       Full_File_Name := Download_Dir_Path + FileName
  166.    ELSE
  167.       Full_File_Name := FileName;
  168.  
  169.                                    (* Open reception file *)
  170.    IF ( NOT RFile_Open ) THEN
  171.       BEGIN
  172.  
  173.          Err := Create_File_Handle( Full_File_Name,
  174.                                     Attribute_None, XFile_Handle );
  175.  
  176.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  177.             BEGIN
  178.  
  179.                GoToXY( 25 , 10 );
  180.                WRITE('Cannot open reception file, receive cancelled.');
  181.                ClrEol;
  182.  
  183.                Write_Log('Cannot open reception file, receive cancelled.',
  184.                          TRUE, FALSE);
  185.  
  186.                DELAY( One_Second_Delay );
  187.  
  188.                Stop_Receive := TRUE;
  189.  
  190.             END
  191.          ELSE
  192.             RFile_Open := TRUE;
  193.  
  194.       END;
  195.  
  196.    IF Rfile_Open THEN
  197.       Write_Log('Receiving file ' + Full_File_Name, TRUE, FALSE );
  198.  
  199. END   (* Open_Receiving_File *);
  200.  
  201. (*----------------------------------------------------------------------*)
  202. (*   Initialize_Receive_Display --- Set up display of Xmodem reception  *)
  203. (*----------------------------------------------------------------------*)
  204.  
  205. PROCEDURE Initialize_Receive_Display;
  206.  
  207. BEGIN (* Initialize_Receive_Display *)
  208.  
  209.    TextColor( Menu_Text_Color_2 );
  210.  
  211.    GoToXY( 1 , 1 );
  212.    WRITE(' Blocks received      :');
  213.    ClrEol;
  214.  
  215.    GoToXY( 1 , 2 );
  216.    WRITE(' Block length errors  :');
  217.    ClrEol;
  218.  
  219.    GoToXY( 1 , 3 );
  220.    WRITE(' SOH errors           :');
  221.    ClrEol;
  222.  
  223.    GoToXY( 1 , 4 );
  224.    WRITE(' Block number errors  :');
  225.    ClrEol;
  226.  
  227.    GoToXY( 1 , 5 );
  228.    WRITE(' Complement errors    :');
  229.    ClrEol;
  230.  
  231.    GoToXY( 1 , 6 );
  232.    WRITE(' Timeout errors       :');
  233.    ClrEol;
  234.  
  235.    GoToXY( 1 , 7 );
  236.    WRITE(' Resend block errors  :');
  237.    ClrEol;
  238.  
  239.    GoToXY( 1 , 8 );
  240.  
  241.    IF ( NOT Use_CRC ) THEN
  242.       WRITE(' Checksum errors      :')
  243.    ELSE
  244.       WRITE(' CRC errors           :');
  245.  
  246.    ClrEol;
  247.  
  248.    GoToXY( 1 , 9 );
  249.  
  250.    IF Display_Time THEN
  251.       WRITE(' Approx. time left    :')
  252.    ELSE
  253.       WRITE(' ');
  254.  
  255.    ClrEol;
  256.  
  257.    GoToXY( 1 , 10 );
  258.    WRITE  (' Last status message  :');
  259.    ClrEol;
  260.  
  261.    TextColor( Menu_Text_Color );
  262.  
  263. END   (* Initialize_Receive_Display *);
  264.  
  265. (*----------------------------------------------------------------------*)
  266. (*        Flip_Display_Status --- turn status display on/off            *)
  267. (*----------------------------------------------------------------------*)
  268.  
  269. PROCEDURE Flip_Display_Status;
  270.  
  271. BEGIN (* Flip_Display_Status *)
  272.  
  273.    CASE Display_Status OF
  274.  
  275.       TRUE:   BEGIN
  276.                                    (* Indicate no display   *)
  277.  
  278.                  Display_Status := FALSE;
  279.  
  280.                                    (* Remove XMODEM window  *)
  281.  
  282.                  Restore_Screen( Saved_Screen );
  283.  
  284.                                    (* Remove batch transfer window *)
  285.  
  286.                  Restore_Screen( Batch_Screen_Ptr );
  287.  
  288.                                    (* Turn cursor back on *)
  289.                  CursorOn;
  290.  
  291.               END;
  292.  
  293.       FALSE:  BEGIN
  294.                                    (* Indicate display will be done *)
  295.  
  296.                  Display_Status := TRUE;
  297.  
  298.                                    (* Turn cursor off *)
  299.                  CursorOff;
  300.  
  301.                                    (* Initialize batch transfer display *)
  302.                                    (* if needed.                        *)
  303.  
  304.                  IF ( NOT Single_File_Protocol[Transfer_Protocol] ) THEN
  305.                     Display_Batch_Window;
  306.  
  307.                                    (* Save screen image *)
  308.  
  309.                  Save_Screen( Saved_Screen );
  310.  
  311.                                    (* Initialize display window     *)
  312.  
  313.                  Draw_Menu_Frame( 15, 10, 78, 22, Menu_Frame_Color,
  314.                                   Menu_Title_Color,
  315.                                   Menu_Text_Color, Menu_Title );
  316.  
  317.                  Window( 16, 11, 77, 21 );
  318.  
  319.                                    (* Set up titles *)
  320.  
  321.                  Initialize_Receive_Display;
  322.  
  323.               END;
  324.  
  325.    END (* CASE *);
  326.  
  327. END   (* Flip_Display_Status *);
  328.  
  329. (*----------------------------------------------------------------------*)
  330. (*         Check_Keyboard_Input --- Check for keyboard input            *)
  331. (*----------------------------------------------------------------------*)
  332.  
  333. PROCEDURE Check_Keyboard_Input;
  334.  
  335. BEGIN (* Check_Keyboard_Input *)
  336.                                    (* Check for keyboard input -- Alt_R *)
  337.                                    (* cancels transfer.                 *)
  338.    WHILE KeyPressed DO
  339.       BEGIN
  340.          READ( Kbd, Kbd_Ch );
  341.          IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN
  342.             BEGIN
  343.                READ( Kbd, Kbd_Ch );
  344.                CASE ORD( Kbd_Ch ) OF
  345.                   Alt_R     : Alt_R_Pressed := TRUE;
  346.                   Shift_Tab : Flip_Display_Status;
  347.                   ELSE        Handle_Function_Key( Kbd_Ch );
  348.                END (* CASE *);
  349.                Stop_Receive   := Stop_Receive OR Alt_R_Pressed;
  350.             END;
  351.       END;
  352.  
  353. END   (* Check_Keyboard_Input *);
  354.  
  355. (*----------------------------------------------------------------------*)
  356. (* Update_Xmodem_Receive_Display --- Update display of Xmodem reception *)
  357. (*----------------------------------------------------------------------*)
  358.  
  359. PROCEDURE  Update_Xmodem_Receive_Display;
  360.  
  361. BEGIN (* Update_Xmodem_Receive_Display *)
  362.  
  363.    GoToXY( 25 , 1 );
  364.    WRITE( Sector_Count );
  365.    GoToXY( 35 , 1 );
  366.    WRITE( Sector_Count SHR 3, 'K' );
  367.    GoToXY( 25 , 2 );
  368.    WRITE(BlockL_Errors);
  369.    GoToXY( 25 , 3 );
  370.    WRITE(SOH_Errors);
  371.    GoToXY( 25 , 4 );
  372.    WRITE(BlockN_Errors);
  373.    GoToXY( 25 , 5 );
  374.    WRITE(Comple_Errors);
  375.    GoToXY( 25 , 6 );
  376.    WRITE(TimeOut_Errors);
  377.    GoToXY( 25 , 7 );
  378.    WRITE(Resend_Errors);
  379.    GoToXY( 25 , 8 );
  380.    WRITE(CRC_Errors);
  381.  
  382.    IF Display_Time THEN
  383.       BEGIN
  384.          GoToXY( 25 , 9 );
  385.          WRITE( TimeString( Time_To_Send , Military_Time ) );
  386.       END;
  387.  
  388. END   (* Update_Xmodem_Receive_Display *);
  389.  
  390. (*----------------------------------------------------------------------*)
  391. (*     Display_Receive_Error --- Display XMODEM reception error         *)
  392. (*----------------------------------------------------------------------*)
  393.  
  394. PROCEDURE Display_Receive_Error( Err_Text: AnyStr );
  395.  
  396. VAR
  397.    S: STRING[10];
  398.  
  399. BEGIN (* Display_Receive_Error *)
  400.  
  401.    IF ( NOT Display_Status ) THEN
  402.       Flip_Display_Status;
  403.  
  404.    STR( Sector_Count , S );
  405.    Err_Mess := Err_Text + ' around block ' + S;
  406.  
  407.    GoToXY( 25 , 10 );
  408.    WRITE(Err_Mess);
  409.    ClrEol;
  410.  
  411.    Write_Log( Err_Mess, TRUE, FALSE );
  412.  
  413.    Error_Flag := TRUE;
  414.  
  415. END   (* Display_Receive_Error *);
  416.  
  417. (*----------------------------------------------------------------------*)
  418. (* WXModem_Receive_With_TimeOut --- Get character from port for WXModem *)
  419. (*----------------------------------------------------------------------*)
  420.  
  421. PROCEDURE WXModem_Receive_With_TimeOut( VAR Ch : INTEGER );
  422.  
  423. (* STRUCTURED *) CONST
  424.    Special_Chars : SET OF BYTE = [DLE,SYN,XON,XOFF];
  425.  
  426. BEGIN (* WXModem_Receive_With_TimeOut *)
  427.  
  428.    Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  429.  
  430.    IF Do_WXModem THEN
  431.       IF ( Ch = DLE ) THEN
  432.          BEGIN
  433.             IF ( Ch IN Special_Chars ) THEN
  434.                BEGIN
  435.                   Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  436.                   IF ( Ch <> TimeOut ) THEN
  437.                      Ch := Ch XOR 64;
  438.                END
  439.          END
  440.       ELSE
  441.          IF ( Ch = SYN ) THEN
  442.             Ch := TimeOut;
  443.  
  444. END   (* WXModem_Receive_With_TimeOut *);
  445.  
  446. (*----------------------------------------------------------------------*)
  447. (*   Xmodem_Receive_With_TimeOut --- Get character from port            *)
  448. (*----------------------------------------------------------------------*)
  449.  
  450. PROCEDURE XModem_Receive_With_TimeOut( VAR Ch : INTEGER );
  451.  
  452. BEGIN (* XModem_Receive_With_TimeOut *)
  453.  
  454.    Async_Receive_With_TimeOut( Xmodem_Char_Wait , Ch );
  455.  
  456.                                    (* Check for buffer overflow *)
  457.                                    (* if not doing ACKs         *)
  458.    IF ( NOT Do_Acks ) THEN
  459.       IF ( Async_Buffer_Used = Async_Buffer_High ) THEN
  460.          BEGIN
  461.             IF ( NOT Async_Xoff_Sent ) THEN
  462.                BEGIN
  463.                   Async_Send( CHR( XOFF ) );
  464.                   Async_Xoff_Sent := TRUE;
  465.                END
  466.          END
  467.       ELSE
  468.          IF ( Async_Buffer_Used = Async_Buffer_High_2 ) THEN
  469.             BEGIN
  470.                Async_Send( CHR( XOFF ) );
  471.                Async_Xoff_Sent := TRUE;
  472.             END;
  473.  
  474. END   (* XModem_Receive_With_TimeOut *);
  475.  
  476. (*----------------------------------------------------------------------*)
  477. (*           Receive_Xmodem_Sector --- Get sector using XMODEM          *)
  478. (*----------------------------------------------------------------------*)
  479.  
  480. FUNCTION Receive_Xmodem_Sector( Use_CRC : BOOLEAN ) : BOOLEAN;
  481.  
  482. (*----------------------------------------------------------------------*)
  483. (*                                                                      *)
  484. (*     Function:   Receive_Xmodem_Sector                                *)
  485. (*                                                                      *)
  486. (*     Purpose:    Gets one sector using XMODEM protocol.               *)
  487. (*                                                                      *)
  488. (*     Calling Sequence:                                                *)
  489. (*                                                                      *)
  490. (*        OK_Get := Receive_Xmodem_Sector( Use_CRC : BOOLEAN )          *)
  491. (*                                       : BOOLEAN;                     *)
  492. (*                                                                      *)
  493. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  494. (*                       of XMODEM; FALSE to use Checksum version.      *)
  495. (*           OK_Get  --- TRUE if sector received correctly              *)
  496. (*                                                                      *)
  497. (*     Calls:   Async_Send                                              *)
  498. (*              Async_Receive_With_TimeOut                              *)
  499. (*              Display_Receive_Error                                   *)
  500. (*              Print_Spooled_File                                      *)
  501. (*                                                                      *)
  502. (*----------------------------------------------------------------------*)
  503.  
  504. VAR
  505.    CRC        : INTEGER;
  506.    Checksum   : INTEGER;
  507.    I          : INTEGER;
  508.    Error_Fl   : BYTE;
  509.    Receive_OK : BOOLEAN;
  510.  
  511.    Debug_Sect : ARRAY[1..128] OF CHAR ABSOLUTE Sector_Data;
  512.  
  513. BEGIN (* Receive_Xmodem_Sector *)
  514.  
  515.                                    (* Clear async error flags        *)
  516.  
  517.    Receive_OK := Async_Line_Error( Error_Fl );
  518.  
  519.                                    (* Pick up sector data, calculate *)
  520.                                    (* checksum or CRC                *)
  521.  
  522.    Receive_Xmodem_Sector := FALSE;
  523.    Receive_OK            := FALSE;
  524.  
  525.    Checksum    := 0;
  526.    CRC         := 0;
  527.                                    (* Sector length is 128 for usual *)
  528.                                    (* Xmodem or Telink; is 1024 for  *)
  529.                                    (* Ymodem.                        *)
  530.  
  531.    FOR I := 1 TO Sector_Length DO
  532.       BEGIN
  533.                                    (* Print character from spooled file *)
  534.          IF Print_Spooling THEN
  535.             Print_Spooled_File;
  536.                                    (* Get next char from comm port *)
  537.  
  538.          IF Do_WXModem THEN
  539.             WXModem_Receive_With_TimeOut( Ch )
  540.          ELSE
  541.             Xmodem_Receive_With_TimeOut( Ch );
  542.  
  543.                                    (* Check for timeout  *)
  544.          IF Ch = TimeOut THEN
  545.             BEGIN
  546.                Display_Receive_Error('Block length error');
  547.                BlockL_Errors := SUCC( BlockL_Errors );
  548.                EXIT;
  549.             END;
  550.  
  551.                                    (* Store received character *)
  552.          Sector_Data[I] := Ch;
  553.                                    (* Update CRC or Checksum   *)
  554.          IF Use_CRC THEN
  555.             BEGIN
  556.                CRC := SWAP( CRC ) XOR ORD( Ch );
  557.                CRC := CRC XOR ( LO( CRC ) SHR 4 );
  558.                CRC := CRC XOR ( SWAP( LO( CRC ) ) SHL 4 )
  559.                           XOR ( LO( CRC ) SHL 5 );
  560.             END
  561.          ELSE
  562.             Checksum := ( Checksum + Ch ) AND 255;
  563.  
  564.       END;
  565.                                    (* Now get trailing CRC or  *)
  566.                                    (* checksum value.          *)
  567.    IF Use_CRC THEN
  568.       BEGIN   (* Receive CRC *)
  569.                                    (* Get first byte of CRC    *)
  570.  
  571.          IF Do_WXModem THEN
  572.             WXModem_Receive_With_TimeOut( Ch )
  573.          ELSE
  574.             Xmodem_Receive_With_TimeOut( Ch );
  575.  
  576.                                    (* Check for timeout        *)
  577.          IF Ch <> TimeOut THEN
  578.             BEGIN  (* Byte CRC OK *)
  579.  
  580.                                    (* Update CRC               *)
  581.  
  582.                CRC := SWAP( CRC ) XOR ORD( Ch );
  583.                CRC := CRC XOR ( LO( CRC ) SHR 4 );
  584.                CRC := CRC XOR ( SWAP( LO( CRC ) ) SHL 4 )
  585.                           XOR ( LO( CRC ) SHL 5 );
  586.  
  587.                                    (* Get second byte of CRC   *)
  588.  
  589.                IF Do_WXModem THEN
  590.                   WXModem_Receive_With_TimeOut( Ch )
  591.                ELSE
  592.                   Xmodem_Receive_With_TimeOut( Ch );
  593.  
  594.                                    (* If not timeout, update CRC *)
  595.                                    (* and check if it is zero.   *)
  596.                                    (* Zero CRC means OK sector.  *)
  597.  
  598.                IF Ch <> TimeOut THEN
  599.                   BEGIN  (* Byte 2 CRC OK *)
  600.  
  601.                      CRC := SWAP( CRC ) XOR ORD( Ch );
  602.                      CRC := CRC XOR ( LO( CRC ) SHR 4 );
  603.                      CRC := CRC XOR ( SWAP( LO( CRC ) ) SHL 4 )
  604.                                 XOR ( LO( CRC ) SHL 5 );
  605.  
  606.                      Receive_OK := ( CRC = 0 );
  607.  
  608.                   END    (* Byte 2 CRC OK *)
  609.                ELSE
  610.                   BEGIN  (* Byte 2 CRC TimeOut *)
  611.  
  612.                      Display_Receive_Error('Block length error');
  613.                      BlockL_Errors := SUCC( BlockL_Errors );
  614.  
  615.                   END    (* Byte 2 CRC TimeOut *)
  616.  
  617.             END   (* Byte 1 CRC OK *)
  618.  
  619.          ELSE
  620.             BEGIN (* Byte 1 CRC TimeOut *)
  621.  
  622.                Display_Receive_Error('Block length error');
  623.                BlockL_Errors := SUCC( BlockL_Errors );
  624.  
  625.             END   (* Byte 1 CRC TimeOut *);
  626.  
  627.       END     (* Compute CRC *)
  628.  
  629.    ELSE
  630.       BEGIN   (* Receive Checksum *)
  631.  
  632.                                    (* Read sector checksum, see if it matches *)
  633.                                    (* what we computed from sector read.      *)
  634.  
  635.          IF Do_WXModem THEN
  636.             WXModem_Receive_With_TimeOut( Ch )
  637.          ELSE
  638.             Xmodem_Receive_With_TimeOut( Ch );
  639.  
  640.          Receive_OK := ( Checksum = Ch );
  641.  
  642.       END    (* Receive Checksum *);
  643.  
  644.    Receive_Xmodem_Sector := Receive_OK AND
  645.                             ( NOT Async_Line_Error( Error_Fl ) );
  646.  
  647. END   (* Receive_Xmodem_Sector *);
  648.  
  649. (*----------------------------------------------------------------------*)
  650. (*           Get_Unix_Style_Date --- Get date in Unix style             *)
  651. (*----------------------------------------------------------------------*)
  652.  
  653. PROCEDURE Get_Unix_Style_Date(     Date  : REAL;
  654.                                VAR Year  : INTEGER;
  655.                                VAR Month : INTEGER;
  656.                                VAR Day   : INTEGER;
  657.                                VAR Hour  : INTEGER;
  658.                                VAR Mins  : INTEGER;
  659.                                VAR Secs  : INTEGER );
  660.  
  661. CONST
  662.    Secs_Per_Year      = 31536000.0;
  663.    Secs_Per_Leap_Year = 31622400.0;
  664.    Secs_Per_Day       = 86400.0;
  665.    Secs_Per_Hour      = 3600.0;
  666.    Secs_Per_Minute    = 60.0;
  667.  
  668. VAR
  669.    RDate     : REAL;
  670.    T         : REAL;
  671.  
  672. (* STRUCTURED *) CONST
  673.    Days_Per_Month : ARRAY[1..12] OF BYTE
  674.                     = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
  675.  
  676. BEGIN (* Get_Unix_Style_Date *)
  677.  
  678.    Year  := 1970;
  679.    Month := 1;
  680.  
  681.    IF ( Transfer_Protocol <> SEALink ) THEN
  682.       RDate := Date - GMT_Difference * Secs_Per_Hour
  683.    ELSE
  684.       RDate := Date;
  685.  
  686.    WHILE( RDate > 0.0 ) DO
  687.       BEGIN
  688.  
  689.          IF ( Year MOD 4 ) = 0 THEN
  690.             T := Secs_Per_Leap_Year
  691.          ELSE
  692.             T := Secs_Per_Year;
  693.  
  694.          RDate := RDate - T;
  695.          Year  := Year  + 1;
  696.  
  697.       END;
  698.  
  699.    RDate := RDate + T;
  700.    Year  := Year  - 1;
  701.  
  702.    IF ( Year MOD 4 ) = 0 THEN
  703.       Days_Per_Month[2] := 29
  704.    ELSE
  705.       Days_Per_Month[2] := 28;
  706.  
  707.    WHILE( RDate > 0.0 ) DO
  708.       BEGIN
  709.  
  710.          T     := Days_Per_Month[Month] * Secs_Per_Day;
  711.  
  712.          RDate := RDate - T;
  713.          Month := Month + 1;
  714.  
  715.       END;
  716.  
  717.    RDate := RDate + T;
  718.    Month := Month - 1;
  719.  
  720.    Day   := TRUNC( INT( ( Rdate + Secs_Per_Day - 1 ) / Secs_Per_Day  ) );
  721.    Rdate := Rdate - ( Day - 1 ) * Secs_Per_Day;
  722.  
  723.    Hour  := TRUNC( INT( Rdate / Secs_Per_Hour ) );
  724.    Rdate := Rdate - Hour * Secs_Per_Hour;
  725.  
  726.    Mins  := TRUNC( INT( Rdate / Secs_Per_Minute ) );
  727.    Secs  := TRUNC( Rdate - Mins * Secs_Per_Minute );
  728.  
  729. END   (* Get_Unix_Style_Date *);
  730.  
  731. (*----------------------------------------------------------------------*)
  732. (*           Receive_Telink_Header --- Get Telink block 0 header        *)
  733. (*----------------------------------------------------------------------*)
  734.  
  735. PROCEDURE Receive_Telink_Header;
  736.  
  737. (*----------------------------------------------------------------------*)
  738. (*                                                                      *)
  739. (*     Procedure:  Receive_Telink_Header                                *)
  740. (*                                                                      *)
  741. (*     Purpose:    Gets Telink header block 0 (filename+size+date)      *)
  742. (*                                                                      *)
  743. (*     Calling Sequence:                                                *)
  744. (*                                                                      *)
  745. (*        Receive_Telink_Header;                                        *)
  746. (*                                                                      *)
  747. (*     Calls:                                                           *)
  748. (*                                                                      *)
  749. (*        Trim                                                          *)
  750. (*        Dir_Convert_Time                                              *)
  751. (*        Dir_Convert_Date                                              *)
  752. (*        Draw_Menu_Frame                                               *)
  753. (*                                                                      *)
  754. (*----------------------------------------------------------------------*)
  755.  
  756. VAR
  757.    I      : INTEGER;
  758.    CDate  : STRING[8];
  759.    CTime  : STRING[8];
  760.    Date   : REAL;
  761.    Year   : INTEGER;
  762.    Month  : INTEGER;
  763.    Day    : INTEGER;
  764.    Hour   : INTEGER;
  765.    Mins   : INTEGER;
  766.    Secs   : INTEGER;
  767.  
  768.    Debug_Sector_Data : PACKED ARRAY[1..44] OF CHAR ABSOLUTE Sector_Data;
  769.  
  770. BEGIN  (* Receive_Telink_Header *)
  771.  
  772.    RFile_Size := 0.0;
  773.    RFile_Name := '';
  774.                                    (* Get file size *)
  775.    FOR I := 4 DOWNTO 1 DO
  776.       RFile_Size := RFile_Size * 256.0 + Sector_Data[I];
  777.  
  778.    Blocks_To_Get  := ROUND( RFile_Size / 128.0 + 0.49 );
  779.  
  780.                                    (* Get time/date *)
  781.  
  782.    IF ( Transfer_Protocol = Telink ) THEN
  783.       BEGIN
  784.          File_Time := Sector_Data[6] SHL 8 OR Sector_Data[5];
  785.          File_Date := Sector_Data[8] SHL 8 OR Sector_Data[7];
  786.       END
  787.    ELSE
  788.       BEGIN
  789.  
  790.          Date := ORD( Sector_Data[8] ) SHL 8 + ORD( Sector_Data[7] );
  791.          Date := 65536.0 * Date + ORD( Sector_Data[6] ) SHL 8 + ORD( Sector_Data[5] );
  792.  
  793.          IF ( Date > 0.0 ) THEN
  794.             BEGIN
  795.  
  796.                Get_Unix_Style_Date( Date, Year, Month, Day, Hour, Mins, Secs );
  797.  
  798.                File_Time := Hour SHL 11 OR Mins SHL 5 OR ( Secs DIV 2 );
  799.                File_Date := MAX( Year - 1980 , 0 ) SHL 9 + Month SHL 5 + Day;
  800.  
  801.             END;
  802.  
  803.       END;
  804.                                    (* Get file name *)
  805.    FOR I := 9 TO 24 DO
  806.       IF Sector_Data[I] <> 0 THEN
  807.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  808.  
  809.    RFile_Name := TRIM( RFile_Name );
  810.  
  811.    IF ( FileName = '' ) THEN
  812.       IF ( RFile_Name <> '' ) THEN
  813.          FileName := RFile_Name;
  814.  
  815.    Draw_Menu_Frame( 15, 10, 78, 23, Menu_Frame_Color, Menu_Title_Color,
  816.                     Menu_Text_Color,
  817.                     'Receive file ' + FileName + ' using ' + Tname );
  818.  
  819.    IF ( ( File_Date <> 0 ) AND ( File_Time <> 0 ) ) THEN
  820.       BEGIN
  821.          Dir_Convert_Time( File_Time, CTime );
  822.          Dir_Convert_Date( File_Date, CDate );
  823.       END
  824.    ELSE
  825.       BEGIN
  826.          CTime := '';
  827.          CDate := '';
  828.       END;
  829.  
  830.    Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color, Menu_Title_Color,
  831.                     Menu_Text_Color, '' );
  832.  
  833.                                    (* Headings for Telink information *)
  834.    Window( 16, 4, 77, 8 );
  835.  
  836.    GoToXY( 1 , 1 );
  837.    TextColor( Menu_Text_Color_2 );
  838.    WRITE(' File name:           ');
  839.    TextColor( Menu_Text_Color );
  840.    WRITE(FileName);
  841.    GoToXY( 1 , 2 );
  842.    TextColor( Menu_Text_Color_2 );
  843.    WRITE(' File Size in bytes:  ');
  844.    TextColor( Menu_Text_Color );
  845.    WRITE(RFile_Size:8:0);
  846.    GoToXY( 1 , 3 );
  847.    TextColor( Menu_Text_Color_2 );
  848.    WRITE(' File Size in blocks: ');
  849.    TextColor( Menu_Text_Color );
  850.    WRITE(Blocks_To_Get:8:0);
  851.    GoToXY( 1 , 4 );
  852.    TextColor( Menu_Text_Color_2 );
  853.    WRITE(' File creation time:  ');
  854.    TextColor( Menu_Text_Color );
  855.    WRITE( CTime );
  856.    GoToXY( 1 , 5 );
  857.    TextColor( Menu_Text_Color_2 );
  858.    WRITE(' File creation date:  ');
  859.    TextColor( Menu_Text_Color );
  860.    WRITE( CDate );
  861.                                    (* Restore previous window *)
  862.    Window( 16, 11, 77, 21 );
  863.  
  864.    IF RFile_Size > 0.0 THEN
  865.       BEGIN
  866.  
  867.          Display_Time   := TRUE;
  868.          Time_To_Send   := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate );
  869.          Time_Per_Block := Time_To_Send / Blocks_To_Get;
  870.  
  871.          IF Display_Status THEN
  872.             Initialize_Receive_Display;
  873.  
  874.          Truncate_File  := TRUE;
  875.  
  876.       END;
  877.                                    (* Handle SEALink file name *)
  878.    IF Do_SeaLink THEN
  879.       BEGIN
  880.                                    (* Prevent clobbers in host mode *)
  881.          IF Host_Mode THEN
  882.             IF ( Privilege <> 'S' ) THEN
  883.                Stop_Receive := Stop_Receive OR
  884.                                Check_If_File_Exists( FileName , Download_Dir_Path );
  885.  
  886.                                   (* If null file name, this means *)
  887.                                   (* end of SEALink batch, so quit. *)
  888.  
  889.          IF LENGTH( RFile_Name ) = 0 THEN
  890.             BEGIN
  891.                Null_File_Name := TRUE;
  892.                EXIT;
  893.             END;
  894.                                    (* Open reception file     *)
  895.  
  896.          IF ( NOT Stop_Receive ) THEN
  897.             Open_Receiving_File;
  898.  
  899.       END;
  900.  
  901. END    (* Receive_Telink_Header *);
  902.  
  903. (*----------------------------------------------------------------------*)
  904. (*           Receive_Ymodem_Header --- Get Ymodem block 0 header        *)
  905. (*----------------------------------------------------------------------*)
  906.  
  907. PROCEDURE Receive_Ymodem_Header;
  908.  
  909. (*----------------------------------------------------------------------*)
  910. (*                                                                      *)
  911. (*     Procedure:  Receive_Ymodem_Header                                *)
  912. (*                                                                      *)
  913. (*     Purpose:    Gets Ymodem header block 0 (filename+size+date)      *)
  914. (*                                                                      *)
  915. (*     Calling Sequence:                                                *)
  916. (*                                                                      *)
  917. (*        Receive_Ymodem_Header                                         *)
  918. (*                                                                      *)
  919. (*     Calls:                                                           *)
  920. (*                                                                      *)
  921. (*        Draw_Menu_Frame                                               *)
  922. (*        Dir_Convert_Time                                              *)
  923. (*        Dir_Convert_Date                                              *)
  924. (*        Open_Receiving_File                                           *)
  925. (*                                                                      *)
  926. (*----------------------------------------------------------------------*)
  927.  
  928. VAR
  929.    I     : INTEGER;
  930.    CTime : STRING[10];
  931.    CDate : STRING[10];
  932.    Year  : INTEGER;
  933.    Month : INTEGER;
  934.    Day   : INTEGER;
  935.    Hour  : INTEGER;
  936.    Mins  : INTEGER;
  937.    Secs  : INTEGER;
  938.  
  939. BEGIN  (* Receive_Ymodem_Header *)
  940.  
  941.    RFile_Size := 0.0;
  942.    RFile_Date := 0.0;
  943.    RFile_Name := '';
  944.    File_Time  := 0;
  945.    File_Date  := 0;
  946.                                    (* Pick up file name *)
  947.    I := 1;
  948.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  949.       BEGIN
  950.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  951.          I          := SUCC( I );
  952.       END;
  953.                                   (* If null file name, this means *)
  954.                                   (* end of Ymodem batch, so quit. *)
  955.    IF LENGTH( RFile_Name ) = 0 THEN
  956.       BEGIN
  957.          Null_File_Name := TRUE;
  958.          EXIT;
  959.       END;
  960.                                   (* Pick up file size *)
  961.    I := SUCC( I );
  962.  
  963.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  964.       BEGIN
  965.          RFile_Size := RFile_Size * 10.0 + ORD( Sector_Data[I] ) - ORD('0');
  966.          I          := SUCC( I );
  967.       END;
  968.  
  969.    I := SUCC( I );
  970.  
  971.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  972.       BEGIN
  973.          RFile_Date := RFile_Date * 8.0 + ORD( Sector_Data[I] ) - ORD('0');
  974.          I          := SUCC( I );
  975.       END;
  976.  
  977.    IF RFile_Date > 0 THEN
  978.       BEGIN
  979.  
  980.          Get_Unix_Style_Date( RFile_Date, Year, Month, Day, Hour, Mins, Secs );
  981.  
  982.          File_Time := Hour SHL 11 OR Mins SHL 5 OR ( Secs DIV 2 );
  983.          File_Date := MAX( Year - 1980 , 0 ) SHL 9 + Month SHL 5 + Day;
  984.  
  985.          Dir_Convert_Time( File_Time, CTime );
  986.          Dir_Convert_Date( File_Date, CDate );
  987.  
  988.       END;
  989.  
  990.    Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color, Menu_Title_Color,
  991.                     Menu_Text_Color,
  992.                     'Receive file ' + RFile_Name + ' using ' + Tname );
  993.  
  994.                                    (* Headings for Ymodem information *)
  995.    Window( 16, 4, 77, 8 );
  996.  
  997.    GoToXY( 1 , 1 );
  998.    TextColor( Menu_Text_Color_2 );
  999.    WRITE(' File name:              ');
  1000.    TextColor( Menu_Text_Color );
  1001.    WRITE(RFile_Name);
  1002.  
  1003.    Blocks_To_Get  := ROUND( RFile_Size / 128.0 + 0.49 );
  1004.  
  1005.    IF RFile_Size > 0.0 THEN
  1006.       BEGIN
  1007.          GoToXY( 1 , 2 );
  1008.          TextColor( Menu_Text_Color_2 );
  1009.          WRITE(' File Size in bytes:     ');
  1010.          TextColor( Menu_Text_Color );
  1011.          WRITE(RFile_Size:8:0);
  1012.          GoToXY( 1 , 3 );
  1013.          TextColor( Menu_Text_Color_2 );
  1014.          WRITE(' File Size in blocks:    ');
  1015.          TextColor( Menu_Text_Color );
  1016.          WRITE(Blocks_To_Get:8:0);
  1017.       END;
  1018.  
  1019.    IF File_Date > 0 THEN
  1020.       BEGIN
  1021.          GoToXY( 1 , 4 );
  1022.          TextColor( Menu_Text_Color_2 );
  1023.          WRITE(' File creation time:     ');
  1024.          TextColor( Menu_Text_Color );
  1025.          WRITE( CTime );
  1026.          GoToXY( 1 , 5 );
  1027.          TextColor( Menu_Text_Color_2 );
  1028.          WRITE(' File creation date:     ');
  1029.          TextColor( Menu_Text_Color );
  1030.          WRITE( CDate );
  1031.       END;
  1032.  
  1033.    FileName := RFile_Name;
  1034.                                    (* Restore previous window *)
  1035.    Window( 16, 11, 77, 21 );
  1036.  
  1037.    IF Rfile_Size > 0.0 THEN
  1038.       BEGIN
  1039.  
  1040.          Display_Time   := TRUE;
  1041.          Time_To_Send   := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate );
  1042.          Time_Per_Block := Time_To_Send / Blocks_To_Get;
  1043.  
  1044.          IF Display_Status THEN
  1045.             Initialize_Receive_Display;
  1046.  
  1047.          Truncate_File  := ( RFile_Size > 0.0 );
  1048.  
  1049.       END;
  1050.                                    (* Prevent clobbers in host mode *)
  1051.    IF Host_Mode THEN
  1052.       IF ( Privilege <> 'S' ) THEN
  1053.          Stop_Receive := Stop_Receive OR
  1054.                          Check_If_File_Exists( FileName , Download_Dir_Path );
  1055.  
  1056.                                    (* Open reception file     *)
  1057.    IF ( NOT Stop_Receive ) THEN
  1058.       Open_Receiving_File;
  1059.                                    (* Post name in display window *)
  1060.  
  1061.    IF ( RFile_Name = '' ) THEN
  1062.       BEGIN
  1063.          Window( 16, 4, 77, 8 );
  1064.          GoToXY( 1 , 1 );
  1065.          TextColor( Menu_Text_Color_2 );
  1066.          WRITE(' File name:              ');
  1067.          TextColor( Menu_Text_Color );
  1068.          WRITE(FileName);
  1069.          Window( 16, 11, 77, 21 );
  1070.       END;
  1071.                                    (* Reset CRC counter       *)
  1072.    CRC_Tries := 0;
  1073.    Use_CRC   := TRUE;
  1074.  
  1075. END    (* Receive_Ymodem_Header *);
  1076.  
  1077. (*----------------------------------------------------------------------*)
  1078. (*        Wait_For_SOH --- Wait for start for start of XMODEM block     *)
  1079. (*----------------------------------------------------------------------*)
  1080.  
  1081. PROCEDURE Wait_For_SOH(     Wait_Time    : INTEGER;
  1082.                         VAR Initial_Ch   : INTEGER;
  1083.                         VAR Stop_Receive : BOOLEAN  );
  1084.  
  1085. (*----------------------------------------------------------------------*)
  1086. (*                                                                      *)
  1087. (*     Procedure:  Wait_For_SOH                                         *)
  1088. (*                                                                      *)
  1089. (*     Purpose:    Waits for SOH/STX/SYN initiating Xmodem block        *)
  1090. (*                                                                      *)
  1091. (*     Calling Sequence:                                                *)
  1092. (*                                                                      *)
  1093. (*        Wait_For_SOH(     Wait_Time    : INTEGER;                     *)
  1094. (*                      VAR Initial_Ch   : INTEGER;                     *)
  1095. (*                      VAR Stop_Receive : BOOLEAN );                   *)
  1096. (*                                                                      *)
  1097. (*           Wait_Time    --- time to wait for character in seconds     *)
  1098. (*           Initial_Ch   --- returned initial character                *)
  1099. (*           Stop_Receive --- TRUE if Alt-R hit to stop transfer        *)
  1100. (*                                                                      *)
  1101. (*     Calls:                                                           *)
  1102. (*                                                                      *)
  1103. (*        Async_Receive_With_TimeOut                                    *)
  1104. (*                                                                      *)
  1105. (*----------------------------------------------------------------------*)
  1106.  
  1107. VAR
  1108.    ITime          : INTEGER;
  1109.    SOH_Start_Time : REAL;
  1110.    SOH_Char       : CHAR;
  1111.  
  1112. BEGIN  (* Wait_For_SOH *)
  1113.                                    (* If already cancelled transfer, *)
  1114.                                    (* don't look for more input!     *)
  1115.    Initial_Ch := TimeOut;
  1116.  
  1117.    IF Stop_Receive THEN EXIT;
  1118.                                    (* Look for start of Xmodem block *)
  1119.    ITime := 0;
  1120.  
  1121.    REPEAT
  1122.  
  1123.       ITime          := SUCC( ITime );
  1124.       Initial_Ch     := TimeOut;
  1125.       SOH_Start_Time := TimeOfDayH;
  1126.  
  1127.       REPEAT
  1128.          IF Async_Receive( SOH_Char ) THEN
  1129.             BEGIN
  1130.                IF ( SOH_Char IN Block_Start_Set ) THEN
  1131.                   Initial_Ch := ORD( SOH_Char );
  1132.             END;
  1133.       UNTIL ( Initial_Ch <> TimeOut ) OR
  1134.             ( TimeDiffH( SOH_Start_Time , TimeOfDayH ) > 100.0 );
  1135.  
  1136.                                    (* Check for keyboard input -- Alt_R *)
  1137.                                    (* cancels transfer.                 *)
  1138.       Check_Keyboard_Input;
  1139.                                    (* Also stop transfer if carrier drops *)
  1140.       IF Async_Carrier_Drop THEN
  1141.          BEGIN
  1142.             Stop_Receive := TRUE;
  1143.             Initial_Ch   := TimeOut;
  1144.          END;
  1145.                                    (* Print character from spooled file *)
  1146.       IF Print_Spooling THEN
  1147.          Print_Spooled_File;
  1148.  
  1149.    UNTIL ( Stop_Receive          OR
  1150.            ( ITime > Wait_Time ) OR
  1151.            ( Initial_Ch <> TimeOut ) );
  1152.  
  1153. END    (* Wait_For_SOH *);
  1154.  
  1155. (*----------------------------------------------------------------------*)
  1156. (*       Set_File_Date_And_Time --- set file date and time stamp        *)
  1157. (*----------------------------------------------------------------------*)
  1158.  
  1159. PROCEDURE Set_File_Date_And_Time;
  1160.  
  1161. VAR
  1162.    OLd_Time   : INTEGER;
  1163.    Old_Date   : INTEGER;
  1164.    Err        : INTEGER;
  1165.    File_Handle: INTEGER;
  1166.  
  1167. (*----------------------------------------------------------------------*)
  1168.  
  1169. PROCEDURE Set_File_Time_Error;
  1170.  
  1171. BEGIN (* Set_File_Time_Error *)
  1172.  
  1173.    IF ( NOT Display_Status ) THEN
  1174.       Flip_Display_Status;
  1175.  
  1176.    GoToXY( 25 , 10 );
  1177.    WRITE('Could not set date/time for file.');
  1178.    ClrEol;
  1179.  
  1180.    DELAY( One_Second_Delay );
  1181.  
  1182. END   (* Set_File_Time_Error *);
  1183.  
  1184. (*----------------------------------------------------------------------*)
  1185.  
  1186. BEGIN (* Set_File_Date_And_Time *)
  1187.  
  1188.    Err  := Open_File_Handle( Full_File_Name, Access_Read_And_Write_Mode,
  1189.                              File_Handle );
  1190.  
  1191.    IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  1192.       BEGIN
  1193.          Set_File_Time_Error;
  1194.          Write_Log('Cannot reopen file to set date/time', TRUE, FALSE );
  1195.          Err  := Close_File_Handle( File_Handle );
  1196.       END
  1197.    ELSE
  1198.       BEGIN
  1199.  
  1200.          Err  := Dir_Set_File_Date_And_Time( File_Handle, File_Date,
  1201.                                              File_Time );
  1202.  
  1203.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  1204.             BEGIN
  1205.                Set_File_Time_Error;
  1206.                Write_Log('Cannot set date/time', TRUE, FALSE );
  1207.                Err  := Close_File_Handle( File_Handle );
  1208.             END
  1209.          ELSE
  1210.             BEGIN
  1211.  
  1212.                Err  := Close_File_Handle( File_Handle );
  1213.  
  1214.                IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  1215.                   BEGIN
  1216.                      Set_File_Time_Error;
  1217.                      Write_Log('Cannot close file after date/time set', TRUE, FALSE );
  1218.                   END
  1219.             END;
  1220.  
  1221.       END;
  1222.  
  1223. END   (* Set_File_Date_And_Time *);
  1224.  
  1225. (*----------------------------------------------------------------------*)
  1226. (*             Write_File_Data --- Write received data to file          *)
  1227. (*----------------------------------------------------------------------*)
  1228.  
  1229. PROCEDURE Write_File_Data;
  1230.  
  1231. PROCEDURE Do_Actual_Write( Write_Count: INTEGER );
  1232.  
  1233. BEGIN (* Do_Actual_Write *)
  1234.  
  1235.    IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND Truncate_File THEN
  1236.       Write_Count := TRUNC( RFile_Size - Rfile_Size_2 );
  1237.  
  1238.    W_Count := Write_Count;
  1239.                                    (* Stop data reception for WXModem *)
  1240.    IF Do_WXModem THEN
  1241.       BEGIN
  1242.          Async_Send( CHR( XOFF ) );
  1243.          DELAY( XOFF_Delay );
  1244.       END;
  1245.  
  1246.    Err     := Write_File_Handle( XFile_Handle, Write_Buffer^, Write_Count );
  1247.  
  1248.    IF Do_WXModem THEN
  1249.       Async_Send( CHR( XON ) );
  1250.  
  1251.    IF ( Err <> 0 ) OR ( Int24Result <> 0 ) OR ( Write_Count <> W_Count ) THEN
  1252.       BEGIN
  1253.  
  1254.          IF ( NOT Display_Status ) THEN
  1255.             Flip_Display_Status;
  1256.  
  1257.          GoToXY( 25 , 10 );
  1258.          WRITE('Error writing to disk, transfer cancelled.');
  1259.          Write_Log('Error writing to disk.' , TRUE, FALSE );
  1260.          ClrEol;
  1261.          DELAY( One_Second_Delay );
  1262.          Stop_Receive := TRUE;
  1263.  
  1264.       END;
  1265.  
  1266.    RFile_Size_2 := RFile_Size_2 + Write_Count;
  1267.  
  1268. END   (* Do_Actual_Write *);
  1269.  
  1270. (*----------------------------------------------------------------------*)
  1271.  
  1272. BEGIN (* Write_File_Data *)
  1273.                                    (* Write directly from sector *)
  1274.                                    (* if not long buffer used    *)
  1275.    IF ( NOT Long_Buffer ) THEN
  1276.       Do_Actual_Write( Sector_Length )
  1277.  
  1278.                                    (* Store sector data in long  *)
  1279.                                    (* buffer and write file if   *)
  1280.                                    (* necessary.                 *)
  1281.  
  1282.    ELSE
  1283.       BEGIN
  1284.  
  1285.          IF ( Buffer_Pos + Sector_Length ) > Buffer_Length THEN
  1286.             BEGIN
  1287.                Do_Actual_Write( Buffer_Pos );
  1288.                Buffer_Pos   := 0;
  1289.             END;
  1290.  
  1291.          MOVE( Sector_Data, Write_Buffer^[ Buffer_Pos + 1 ], Sector_Length );
  1292.  
  1293.          Buffer_Pos := Buffer_Pos + Sector_Length;
  1294.  
  1295.       END;
  1296.  
  1297. END   (* Write_File_Data *);
  1298.  
  1299. (*----------------------------------------------------------------------*)
  1300. (*             Cancel_Transfer --- Cancel transfer                      *)
  1301. (*----------------------------------------------------------------------*)
  1302.  
  1303. PROCEDURE Cancel_Transfer;
  1304.  
  1305. BEGIN (* Cancel_Transfer *)
  1306.                                    (* Purge reception *)
  1307.    Async_Purge_Buffer;
  1308.                                    (* Send five cancels, then five *)
  1309.                                    (* backspaces.                  *)
  1310.    Async_Send( CHR( CAN ) );
  1311.    Async_Send( CHR( CAN ) );
  1312.    Async_Send( CHR( CAN ) );
  1313.    Async_Send( CHR( CAN ) );
  1314.    Async_Send( CHR( CAN ) );
  1315.  
  1316.    Async_Send( CHR( BS  ) );
  1317.    Async_Send( CHR( BS  ) );
  1318.    Async_Send( CHR( BS  ) );
  1319.    Async_Send( CHR( BS  ) );
  1320.    Async_Send( CHR( BS  ) );
  1321.  
  1322.    Write_Log('Receive cancelled.' , TRUE, FALSE );
  1323.  
  1324. END   (* Cancel_Transfer *);
  1325.